home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / memory.swg / 0036_Nice XMS unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-02  |  11.3 KB  |  646 lines
  1. {
  2. PETER BEEFTINK
  3.  
  4. See below an XMS Unit I picked up somewhere.  I must admit that I have never
  5. been successful at using it, but maybe you have more luck.
  6. }
  7.  
  8. Unit MegaXMS;
  9.  
  10. Interface
  11.  
  12. Var
  13.   Present  : Boolean; {True if XMM driver is installed}
  14.   XMSError : Byte;    {Error number. if 0 -> no error}
  15.  
  16. Function  XMMPresent : Boolean;
  17. Function  XMSErrorString(Error : Byte) : String;
  18. Function  XMSMemAvail : Word;
  19. Function  XMSMaxAvail : Word;
  20. Function  GetXMMVersion : Word;
  21. Function  GetXMSVersion : Word;
  22. Procedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);
  23. Procedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);
  24. Function  EMBGetMem(Size : Word) : Word;
  25. Procedure EMBFreeMem(Handle : Word);
  26. Procedure EMBResize(Handle, Size : Word);
  27. Function  GetAvailEMBHandles : Byte;
  28. Function  GetEMBLock(Handle : Word) : Byte;
  29. Function  GetEMBSize(Handle : Word) : Word;
  30. Function  LockEMB(Handle : Word) : LongInt;
  31. Procedure UnlockEMB(Handle : Word);
  32. Function  UMBGetMem(Size : Word; Var Segment : Word) : Word;
  33. Procedure UMBFreeMem(Segment : Word);
  34. Function  GetA20Status : Boolean;
  35. Procedure DisableLocalA20;
  36. Procedure EnableLocalA20;
  37. Procedure DisableGlobalA20;
  38. Procedure EnableGlobalA20;
  39. Procedure HMAGetMem(Size : Word);
  40. Procedure HMAFreeMem;
  41. Function  GetHMA : Boolean;
  42.  
  43. Implementation
  44.  
  45. Uses
  46.   Dos;
  47.  
  48. Const
  49.   High = 1;
  50.   Low  = 2;
  51.   NumberOfErrors = 27;
  52.  
  53.   ErrorNumber : Array [1..NumberOfErrors] Of Byte =
  54.     ($80,$81,$82,$8E,$8F,$90,$91,$92,$93,$94,$A0,$A1,$A2,$A3,
  55.      $A4,$A5,$A6,$A7,$A8,$A9,$AA,$AB,$AC,$AD,$B0,$B1,$B2);
  56.  
  57.   ErrorString : Array [0..NumberOfErrors] Of String = (
  58.     'Unknown error',
  59.     'Function no implemented',
  60.     'VDISK device driver was detected',
  61.     'A20 error occured',
  62.     'General driver errror',
  63.     'Unrecoverable driver error',
  64.     'High memory area does not exist',
  65.     'High memory area is already in use',
  66.     'DX is less than the ninimum of KB that Program may use',
  67.     'High memory area not allocated',
  68.     'A20 line still enabled',
  69.     'All extended memory is allocated',
  70.     'Extended memory handles exhausted',
  71.     'Invalid handle',
  72.     'Invalid source handle',
  73.     'Invalid source offset',
  74.     'Invalid destination handle',
  75.     'Invalid destination offset',
  76.     'Invalid length',
  77.     'Invalid overlap in move request',
  78.     'Parity error detected',
  79.     'Block is not locked',
  80.     'Block is locked',
  81.     'Lock count overflowed',
  82.     'Lock failed',
  83.     'Smaller UMB is available',
  84.     'No UMBs are available',
  85.     'Inavlid UMB segment number');
  86.  
  87. Type
  88.   XMSParamBlock= Record
  89.     Length  : LongInt;
  90.     SHandle : Word;
  91.     SOffset : Array [High..Low] Of Word;
  92.     DHandle : Word;
  93.     DOffset : Array [High..Low] Of Word;
  94.   end;
  95.  
  96. Var
  97.   XMSAddr : Array [High..Low] Of Word; {XMM driver address 1=Low,2=High}
  98.  
  99. Function XMMPresent: Boolean;
  100. Var
  101.   Regs : Registers;
  102. begin
  103.   Regs.AX := $4300;
  104.   Intr($2F, Regs);
  105.   XMMPresent := Regs.AL = $80;
  106. end;
  107.  
  108. Function XMSErrorString(Error : Byte) : String;
  109. Var
  110.   I, Index : Byte;
  111. begin
  112.   Index := 0;
  113.   For I := 1 To NumberOfErrors Do
  114.     if ErrorNumber[I] = Error Then
  115.       Index := I;
  116.   XMSErrorString := ErrorString[Index];
  117. end;
  118.  
  119. Function XMSMemAvail : Word;
  120. Var
  121.   Memory : Word;
  122. begin
  123.   XMSError := 0;
  124.   if Not(Present) Then
  125.     Exit;
  126.   Asm
  127.     Mov  AH, 8
  128.     Call [XMSAddr]
  129.     Or   AX, AX
  130.     Jne  @@1
  131.     Mov  XMSError, BL
  132.     Jmp  @@2
  133.    @@1:
  134.     Mov  Memory, DX
  135.    @@2:
  136.   end;
  137.   XMSMemAvail := Memory;
  138. end;
  139.  
  140. Function XMSMaxAvail : Word;
  141. Var
  142.   Temp : Word;
  143. begin
  144.   XMSError := 0;
  145.   if Not(Present) Then
  146.     Exit;
  147.   Asm
  148.     Mov  AH, 8
  149.     Call [XMSAddr]
  150.     Or   AX, AX
  151.     Jne  @@1
  152.     Mov  XMSError, BL
  153.     Jmp  @@2
  154.    @@1:
  155.     Mov  Temp, AX
  156.    @@2:
  157.   end;
  158.   XMSMaxAvail := Temp;
  159. end;
  160.  
  161. Function EMBGetMem(Size : Word) : Word;
  162. Var
  163.   Temp : Word;
  164. begin
  165.   XMSError := 0;
  166.   if Not(Present) Then
  167.     Exit;
  168.   Asm
  169.     Mov  AH, 9
  170.     Mov  DX, Size
  171.     Call [XMSAddr]
  172.     Or   AX, AX
  173.     Jne  @@1
  174.     Mov  XMSError, BL
  175.     Jmp  @@2
  176.    @@1:
  177.     Mov  Temp, DX
  178.    @@2:
  179.   end;
  180.   EMBGetMem := Temp;
  181. end;
  182.  
  183. Procedure EMBFreeMem(Handle : Word);
  184. begin
  185.   XMSError := 0;
  186.   if Not(Present) Then
  187.     Exit;
  188.   Asm
  189.     Mov  AH, 0Ah
  190.     Mov  DX, Handle
  191.     Call [XMSAddr]
  192.     Or   AX, AX
  193.     Jne  @@1
  194.     Mov  XMSError, BL
  195.    @@1:
  196.   end;
  197. end;
  198.  
  199. Procedure EMBResize(Handle, Size : Word);
  200. begin
  201.   XMSError := 0;
  202.   if Not(Present) Then
  203.     Exit;
  204.   Asm
  205.     Mov  AH, 0Fh
  206.     Mov  DX, Handle
  207.     Mov  BX, Size
  208.     Call [XMSAddr]
  209.     Or   AX, AX
  210.     Jne  @@1
  211.     Mov  XMSError, BL
  212.    @@1:
  213.   end;
  214. end;
  215.  
  216. Procedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);
  217. Var
  218.   ParamBlock : XMSParamBlock;
  219.   XSeg, PSeg,
  220.   POfs       : Word;
  221. begin
  222.   XMSError := 0;
  223.   if Not(Present) Then
  224.     Exit;
  225.   With ParamBlock Do
  226.   begin
  227.     Length        := BlockLength;
  228.     SHandle       := 0;
  229.     SOffset[High] := Ofs(Source);
  230.     SOffset[Low]  := Seg(Source);
  231.     DHandle       := Handle;
  232.     DOffset[High] := 0;
  233.     DOffset[Low]  := 0;
  234.   end;
  235.   PSeg := Seg(ParamBlock);
  236.   POfs := Ofs(ParamBlock);
  237.   XSeg := Seg(XMSAddr);
  238.  
  239.   Asm
  240.     Push DS
  241.     Mov  AH, 0Bh
  242.     Mov  SI, POfs
  243.     Mov  BX, XSeg
  244.     Mov  ES, BX
  245.     Mov  BX, PSeg
  246.     Mov  DS, BX
  247.     Call [ES:XMSAddr]
  248.     Or   AX, AX
  249.     Jne  @@1
  250.     Mov  XMSError, BL
  251.    @@1:
  252.     Pop  DS
  253.   end;
  254. end;
  255.  
  256. Procedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);
  257. Var
  258.   ParamBlock : XMSParamBlock;
  259.   XSeg, PSeg,
  260.   POfs       : Word;
  261. begin
  262.   XMSError := 0;
  263.   if Not(Present) Then
  264.     Exit;
  265.   With ParamBlock Do
  266.   begin
  267.     Length        := BlockLength;
  268.     SHandle       := Handle;
  269.     SOffset[High] := 0;
  270.     SOffset[Low]  := 0;
  271.     DHandle       := 0;
  272.     DOffset[High] := Ofs(Dest);
  273.     DOffset[Low]  := Seg(Dest);
  274.   end;
  275.   PSeg := Seg(ParamBlock);
  276.   POfs := Ofs(ParamBlock);
  277.   XSeg := Seg(XMSAddr);
  278.  
  279.   Asm
  280.     Push DS
  281.     Mov  AH, 0Bh
  282.     Mov  SI, POfs
  283.     Mov  BX, XSeg;
  284.     Mov  ES, BX
  285.     Mov  BX, PSeg
  286.     Mov  DS, BX
  287.     Call [ES:XMSAddr]
  288.     Or   AX, AX
  289.     Jne  @@1
  290.     Mov  XMSError, BL
  291.    @@1:
  292.     Pop  DS
  293.   end;
  294. end;
  295.  
  296. Function GetXMSVersion : Word;
  297. Var
  298.   HighB, LowB : Byte;
  299. begin
  300.   XMSError := 0;
  301.   if Not(Present) Then
  302.     Exit;
  303.   Asm
  304.     Mov  AH, 0
  305.     Call [XMSAddr]
  306.     Or   AX, AX
  307.     Jne  @@1
  308.     Mov  XMSError, BL
  309.     Jmp  @@2
  310.    @@1:
  311.     Mov  HighB, AH
  312.     Mov  LowB, AL
  313.    @@2:
  314.   end;
  315.   GetXMSVersion := (HighB * 100) + LowB;
  316. end;
  317.  
  318. Function GetXMMVersion : Word;
  319. Var
  320.   HighB, LowB : Byte;
  321. begin
  322.   XMSError := 0;
  323.   if Not(Present) Then
  324.     Exit;
  325.   Asm
  326.     Mov  AH, 0
  327.     Call [XMSAddr]
  328.     Or   AX, AX
  329.     Jne  @@1
  330.     Mov  XMSError, BL
  331.     Jmp  @@2
  332.    @@1:
  333.     Mov  HighB, BH
  334.     Mov  LowB, BL
  335.    @@2:
  336.   end;
  337.   GetXMMVersion := (HighB * 100) + LowB;
  338. end;
  339.  
  340. Function GetHMA : Boolean;
  341. Var
  342.   Temp : Boolean;
  343. begin
  344.   XMSError := 0;
  345.   if Not(Present) Then
  346.     Exit;
  347.   Temp := False;
  348.   Asm
  349.     Mov  AH, 0
  350.     Call [XMSAddr]
  351.     Or   AX, AX
  352.     Jne  @@1
  353.     Mov  XMSError, BL
  354.     Jmp  @@2
  355.    @@1:
  356.     Cmp  DX, 0
  357.     Je   @@2
  358.     Mov  Temp, 1
  359.    @@2:
  360.   end;
  361.   GetHMA := Temp;
  362. end;
  363.  
  364. Procedure HMAGetMem(Size : Word);
  365. begin
  366.   XMSError := 0;
  367.   if Not(Present) Then
  368.     Exit;
  369.   Asm
  370.     Mov  AH, 1
  371.     Mov  DX, Size
  372.     Call [XMSAddr]
  373.     Or   AX, AX
  374.     Jne  @@1
  375.     Mov  XMSError, BL
  376.    @@1:
  377.   end;
  378. end;
  379.  
  380. Procedure HMAFreeMem;
  381. begin
  382.   XMSError := 0;
  383.   if Not(Present) Then
  384.     Exit;
  385.   Asm
  386.     Mov  AH, 2
  387.     Call [XMSAddr]
  388.     Or   AX, AX
  389.     Jne  @@1
  390.     Mov  XMSError, BL
  391.    @@1:
  392.   end;
  393. end;
  394.  
  395. Procedure EnableGlobalA20;
  396. begin
  397.   XMSError := 0;
  398.   if Not(Present) Then
  399.     Exit;
  400.   Asm
  401.     Mov  AH, 3
  402.     Call [XMSAddr]
  403.     Or   AX, AX
  404.     Jne  @@1
  405.     Mov  XMSError, BL
  406.    @@1:
  407.   end;
  408. end;
  409.  
  410.  
  411. Procedure DisableGlobalA20;
  412. begin
  413.   XMSError := 0;
  414.   if Not(Present) Then
  415.     Exit;
  416.   Asm
  417.     Mov  AH, 4
  418.     Call [XMSAddr]
  419.     Or   AX, AX
  420.     Jne  @@1
  421.     Mov  XMSError, BL
  422.    @@1:
  423.   end;
  424. end;
  425.  
  426. Procedure EnableLocalA20;
  427. begin
  428.   XMSError := 0;
  429.   if Not(Present) Then Exit;
  430.   Asm
  431.     Mov  AH, 5
  432.     Call [XMSAddr]
  433.     Or   AX, AX
  434.     Jne  @@1
  435.     Mov  XMSError, BL
  436.    @@1:
  437.   end;
  438. end;
  439.  
  440. Procedure DisableLocalA20;
  441. begin
  442.   XMSError := 0;
  443.   if Not(Present) Then
  444.     Exit;
  445.   Asm
  446.     Mov  AH, 6
  447.     Call [XMSAddr]
  448.     Or   AX, AX
  449.     Jne  @@1
  450.     Mov  XMSError, BL
  451.    @@1:
  452.   end;
  453. end;
  454.  
  455. Function GetA20Status : Boolean;
  456. Var
  457.   Temp : Boolean;
  458. begin
  459.   XMSError := 0;
  460.   if Not(Present) Then
  461.     Exit;
  462.   Temp := True;
  463.   Asm
  464.     Mov  AH, 6
  465.     Call [XMSAddr]
  466.     Or   AX, AX
  467.     Jne  @@1
  468.     Mov  XMSError, BL
  469.     Or   AX, AX
  470.     Jne  @@1
  471.     Or   BL, BL
  472.     Jne  @@2
  473.     Mov  Temp, 0
  474.     Jmp  @@1
  475.    @@2:
  476.     Mov  XMSError, BL
  477.    @@1:
  478.   end;
  479. end;
  480.  
  481. Function LockEMB(Handle : Word) : LongInt;
  482. Var
  483.   Temp1,
  484.   Temp2 : Word;
  485.   Temp  : LongInt;
  486. begin
  487.   XMSError := 0;
  488.   if Not(Present) Then
  489.     Exit;
  490.   Asm
  491.     Mov  AH, 0Ch
  492.     Mov  DX, Handle
  493.     Call [XMSAddr]
  494.     Or   AX, AX
  495.     Jne  @@1
  496.     Mov  XMSError, BL
  497.     Jmp  @@2
  498.    @@1:
  499.     Mov  Temp1, DX
  500.     Mov  Temp2, BX
  501.    @@2:
  502.   end;
  503.   Temp := Temp1;
  504.   LockEMB := (Temp Shl 4) + Temp2;
  505. end;
  506.  
  507. Procedure UnlockEMB(Handle : Word);
  508. begin
  509.   XMSError := 0;
  510.   if Not(Present) Then
  511.     Exit;
  512.   Asm
  513.     Mov  AH, 0Dh
  514.     Mov  DX, Handle
  515.     Call [XMSAddr]
  516.     Or   AX, AX
  517.     Jne  @@1
  518.     Mov  XMSError, BL
  519.    @@1:
  520.   end;
  521. end;
  522.  
  523. Function GetEMBSize(Handle : Word) : Word;
  524. Var
  525.   Temp : Word;
  526. begin
  527.   XMSError := 0;
  528.   if Not(Present) Then
  529.     Exit;
  530.   Asm
  531.     Mov  AH, 0Eh
  532.     Mov  DX, Handle
  533.     Call [XMSAddr]
  534.     Or   AX, AX
  535.     Jne  @@1
  536.     Mov  XMSError, BL
  537.     Jmp  @@2
  538.    @@1:
  539.     Mov  Temp, DX
  540.    @@2:
  541.   end;
  542.   GetEMBSize := Temp;
  543. end;
  544.  
  545. Function GetEMBLock(Handle : Word) : Byte;
  546. Var
  547.   Temp : Byte;
  548. begin
  549.   XMSError := 0;
  550.   if Not(Present) Then
  551.     Exit;
  552.   Asm
  553.     Mov  AH, 0Eh
  554.     Mov  DX, Handle
  555.     Call [XMSAddr]
  556.     Or   AX, AX
  557.     Jne  @@1
  558.     Mov  XMSError, BL
  559.     Jmp  @@2
  560.    @@1:
  561.     Mov  Temp, BH
  562.    @@2:
  563.   end;
  564.   GetEMBLock := Temp;
  565. end;
  566.  
  567. Function GetAvailEMBHandles : Byte;
  568. Var
  569.   Temp : Byte;
  570. begin
  571.   XMSError := 0;
  572.   if Not(Present) Then
  573.     Exit;
  574.   Asm
  575.     Mov  AH, 0Eh
  576.     Call [XMSAddr]
  577.     Or   AX, AX
  578.     Jne  @@1
  579.     Mov  XMSError, BL
  580.     Jmp  @@2
  581.    @@1:
  582.     Mov  Temp, BL
  583.    @@2:
  584.   end;
  585.   GetAvailEMBHandles := Temp;
  586. end;
  587.  
  588. Function UMBGetMem(Size : Word; Var Segment : Word) : Word; {Actual size}
  589. Var
  590.   Temp1, Temp2 : Word;
  591. begin
  592.   XMSError := 0;
  593.   if Not(Present) Then
  594.     Exit;
  595.   Asm
  596.     Mov  AH, 10h
  597.     Mov  DX, Size
  598.     Call [XMSAddr]
  599.     Or   AX, AX
  600.     Jne  @@1
  601.     Mov  XMSError, BL
  602.     Jmp  @@2
  603.    @@1:
  604.     Mov  Temp2, BX
  605.    @@2:
  606.     Mov  Temp1, DX
  607.   end;
  608.   Segment := Temp2;
  609.   UMBGetMem := Temp1;
  610. end;
  611.  
  612. Procedure UMBFreeMem(Segment : Word);
  613. begin
  614.   XMSError := 0;
  615.   if Not(Present) Then
  616.     Exit;
  617.   Asm
  618.     Mov  AH, 10h
  619.     Mov  DX, Segment
  620.     Call [XMSAddr]
  621.     Or   AX, AX
  622.     Jne  @@1
  623.     Mov  XMSError, BL
  624.    @@1:
  625.   end;
  626. end;
  627.  
  628. Var
  629.   Regs : Registers;
  630. begin
  631.   if Not(XMMPresent) Then
  632.   begin
  633.     WriteLn('XMS not supported!');
  634.     Present := False;
  635.     Exit;
  636.   end;
  637.   Present := True;
  638.   With Regs Do
  639.   begin
  640.     AX := $4310;
  641.     Intr($2F, Regs);
  642.     XMSAddr[High] := BX;
  643.     XMSAddr[Low]  := ES;
  644.   end;
  645. end.
  646.